(ns clj.jtacck.cache
  (:import java.lang.ref.SoftReference))

(def ^{:private true}
     cache (ref {}))

(defn- current-timestamp []
  (System/currentTimeMillis))

(defn add-to-cache
  "Add the given value to cache with its corresponding key value.

  A value may or may not be stored in the cache forever.  It is stored
  with a SoftReference so it can be garbage collected at any time.

  Also, optionally, a lifetime in milliseconds can be specified.  If
  the value has been stored in the cache longer than its lifetime, it
  can definitely no longer be retrieved.

  If the given key already has a cached value, it will be replaced.

  This function returns the value put into the cache."
  ([key value]
     (dosync (alter cache assoc
		    key (SoftReference.
			 [{} value]))
	     value))
  ([key value lifetime]
     (dosync (alter cache assoc
		    key (SoftReference.
			 [{:timestamp (current-timestamp)
			   :lifetime lifetime} value]))
	     value)))

(defn- cache-still-alive?
  "Given a cache item's meta, will return a truthy value iff the meta
  states that the cache item is still alive (not past its lifetime)."
  [meta]
  (or (not (:lifetime meta))
      (and (< (- (current-timestamp)
		 (:timestamp meta))
	      (:lifetime meta)))))

(defn- remove-from-cache
  "If existant, removes the cache item with the given key from the
  cache."
  [key]
  (dosync (when-let [val-ref (get @cache key)]
	    (do (.clear val-ref)
		(alter cache dissoc key)
		nil))))

(defn retrieve-from-cache
  "Tries to retrieve the value corresponding the
  given key in the cache.  Returns nil if no value
  is found."
  [key]
  (when-let [val-ref (get @cache key)]
    (dosync
     (let [[meta val :as store] (.get val-ref)]
       (when store
	 (if (cache-still-alive? meta)
	   val
	   (remove-from-cache key)))))))

(defn clear-cache
  "Clears the entire cache and forces a garbage collection."
  []
  (dosync (ref-set cache {}))
  (System/gc))

(defmacro cache-or-compute
  "Either returns what is in the cache for the evaluated key-expr or
  evaluates the val-expr, caches the evaluation, and then returns the
  evaluation.  Has the same semantics as add-to-cache for caching the
  evaluation.

  Note: If the cached value is nil, val-expr will be computed and
  cached."
  ([key-expr val-expr]
     `(dosync
       (let [key# ~key-expr
	     cached-val# (retrieve-from-cache key#)]
	 (if (nil? cached-val#)
	   (add-to-cache key# ~val-expr)
	   cached-val#))))
    ([key-expr val-expr lifetime]
       `(dosync
	 (let [key# ~key-expr
	       cached-val# (retrieve-from-cache key#)]
	   (if (nil? cached-val#)
	     (add-to-cache key# ~val-expr ~lifetime)
	     cached-val#)))))

(def ^{:private true} compact-cache-interval (atom (* 60 1000)))
(def ^{:private true} compact-cache? (atom false))
(def ^{:private true} cache-compactor (agent nil))

(defn set-compactor-interval
  "Sets the interval (in milliseconds) for the cache compactor to
  pause between garbage collecting.

  Default interval: 1 minute"
  [millis]
  (swap! compact-cache-interval (constantly millis)))

(defn- compact-cache
  "An agent function that checks the cache for dead items, clears
  them, and then recursively sends the agent itself after the
  compact-cache-interval of waiting."
  [_ agent]
  (when @compact-cache?
    (dorun (for [[key val-ref] @cache
		 :let [[meta _] (.get val-ref)]]
	     (when-not (and meta (cache-still-alive? meta))
	       (dosync (when-let [val-ref-check (get @cache key)]
			 (when (= meta (first (.get val-ref-check))) ; Check for same cache item
			   (remove-from-cache key)))))))
    (Thread/sleep @compact-cache-interval)
    (send agent compact-cache agent)))

(defn start-cache-compactor
  "Asynchronously starts a periodic checking of the cache, clearing
  any items past their lifetimes, and compacting the cache to just
  items that are alive."
  []
  (when-not @compact-cache?
    (swap! compact-cache? (constantly true))
    (send cache-compactor compact-cache cache-compactor)
    nil))

(defn stop-cache-compactor
  "Stops the periodic compacting of the cache.  As usual, cache items
  will still be unrecoverable if they are past their lifetimes."
  []
  (swap! compact-cache? (constantly false))
  nil)